home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.10 Oct 88 / Forth / Notification Manager < prev   
Encoding:
Text File  |  1988-08-18  |  11.3 KB  |  576 lines  |  [TEXT/MACH]
  1. \ notification manager example
  2. \ JL 15.8.88
  3.  
  4. only forth definitions
  5. also assembler also mac also i/o
  6. decimal 
  7.  
  8. \ structure of a NM record
  9.  
  10. 0    CONSTANT    qLink    \ pointer
  11. 4    CONSTANT    qType    \ integer
  12. 6    CONSTANT    nmFlags    \ integer
  13. 8    CONSTANT    nmPrivate    \ longint
  14. 12    CONSTANT    nmReserved    \ integer
  15. 14    CONSTANT    nmMark    \ integer
  16. 16    CONSTANT    nmSIcon    \ handle
  17. 20    CONSTANT    nmSound    \ handle
  18. 24    CONSTANT    nmStr    \ StringPtr
  19. 28    CONSTANT    nmResp    \ ProcPtr
  20. 32    CONSTANT    nmRefCon    \ longint
  21.  
  22. 8    CONSTANT    nmType
  23.     
  24. .TRAP    _NMInstall    $A05E
  25. .TRAP    _NMRemove    $A05F
  26.  
  27. CODE    NMInstall    ( NMRec -- result )
  28.     MOVE.L    (A6)+,A0
  29.     _NMInstall
  30.     MOVE.L    D0,-(A6)
  31.     RTS
  32. END-CODE MACH
  33.  
  34. CODE    NMRemove    ( NMRec -- result )
  35.     MOVE.L    (A6)+,A0
  36.     _NMRemove
  37.     MOVE.L    D0,-(A6)
  38.     RTS
  39. END-CODE MACH
  40.  
  41. $5E CONSTANT nmTrap#
  42. $9F CONSTANT unkTrap#
  43.  
  44. variable myNMRec 32 vallot
  45. variable nmPresent    \ for checking whether the NM is implemented
  46. variable nmChanged    \ flag for telling supervisor task
  47.                     \ that something has changed
  48. variable nmSecs        \ time in seconds for next notify alert
  49.  
  50. : notify-request
  51.     { mark SIcon sound str resp refCon | -- 
  52.                     nmPtr result }
  53.  
  54.         nmType    mynmRec qType + w!
  55.         mark    mynmRec nmMark + w!
  56.         SIcon    mynmRec nmSIcon + !
  57.         sound    mynmRec nmSound + !
  58.         str        mynmRec nmStr + !
  59.         resp    mynmRec nmResp + !
  60.         refCon    mynmRec nmRefCon + !
  61.  
  62.         mynmRec dup NMInstall
  63. ;
  64.  
  65. 300 CONSTANT AppleID
  66. 301 CONSTANT FileID
  67. 302 CONSTANT EditID
  68.  
  69. 2000 CONSTANT updID
  70. 2001 CONSTANT msgID
  71.  
  72. 110 CONSTANT wVisible \ offset into window record
  73.  
  74. 132 USER modelessVector
  75.  60 USER fID
  76.  
  77. CREATE APPLESTRING  $01 C,  $14 C, 
  78.  
  79. NEW.WINDOW nmWindow
  80.  
  81. " NM" nmWindow TITLE
  82. 1 1 16 16 nmWindow BOUNDS
  83. Plain Visible NoCloseBox NoGrowBox nmWindow ITEMS
  84.  
  85. 600 4000 TERMINAL nmTask
  86.  
  87. NEW.MBAR nmBar 
  88.  
  89. NEW.MENU AppleMenu
  90. APPLESTRING AppleMenu TITLE
  91. 0 APPLEID AppleMenu BOUNDS
  92. " About Appointments ...;(-" AppleMenu ITEMS
  93.  
  94. NEW.MENU FileMenu
  95. " File" FileMenu TITLE
  96. 0 FileID FileMenu BOUNDS
  97. " Close;Quit"    FileMenu ITEMS
  98.  
  99. NEW.MENU EditMenu
  100. " Edit" EditMenu TITLE
  101. 0 EditID EditMenu BOUNDS
  102. " (Undo/Z;(-;Cut/K;Copy/C;Paste/V;Clear" EditMenu ITEMS
  103.  
  104. VARIABLE DAName 60 VALLOT
  105. VARIABLE updStore 160 VALLOT \ for 'update appointments' dialog
  106. VARIABLE msgStore 160 VALLOT \ for 'edit message' dialog
  107. VARIABLE updPtr
  108. VARIABLE msgPtr    \ for storing the dialog pointers
  109. VARIABLE updRect 4 vallot
  110. VARIABLE hUpdList    \ stores list handle
  111. VARIABLE listRows    \ total # of rows in list 
  112. VARIABLE datim 10 VALLOT \ 14 bytes for date-time record
  113. VARIABLE msgTxt 252 VALLOT \ 256 bytes for item text
  114.  
  115. \ ***** list manager support
  116.  
  117. \ List Manager select flags.
  118. 128    CONSTANT OnlyOne
  119.  64    CONSTANT ExtendDrag
  120.  32    CONSTANT NoDisjoint
  121.  16    CONSTANT NoExtend
  122.   8    CONSTANT NoRect
  123.   4    CONSTANT UseSense
  124.   2    CONSTANT NoNilHilite
  125.   
  126. \ Offsets into the List record
  127.  12    CONSTANT IndentOffset
  128.  36    CONSTANT SelFlags
  129.  80    CONSTANT LDataHandle
  130.  
  131. CREATE ArrayDim    \ Initially we will have an empty array.
  132.                 \ We'll add rows and columns later.
  133.     0    W,        \ Row-o.
  134.     0    W,        \ Column-o.
  135.     0    W,        \ Row-i.
  136.     1    W,        \ Column-i.
  137.  
  138. : NewVList ( rview databounds size wPtr - lhandle )
  139.     0        \ LDEF proc id
  140.     swap    \ window pointer
  141.     0        \ DrawIt flag
  142.     0        \ HasGrow flag
  143.     0        \ scrollHoriz flag
  144.     -1        \ scrollVert flag
  145.     (CALL) LNew    
  146. ;
  147.  
  148. : MakeList { rect vcell hcell wPtr | 
  149.             lhandle cellpt rectbr recttl -- lhandle }
  150.     rect     @ $10001 + -> recttl
  151.     rect 4 + @ $10010 - -> rectbr
  152.     ^ recttl            \ Pass rectangle.
  153.     ArrayDim            \ Pass bounds.
  154.     vCell ^ cellpt W!
  155.     hCell ^ cellpt 2+ W!
  156.     cellpt                \ Pass cell size.
  157.     wPtr
  158.     NewVList -> lhandle
  159.     
  160.     OnlyOne NoNilHilite +        \ Select only one cell at a time.
  161.     lhandle @ SelFlags + C!        \ Don't hilite empty cells.
  162.     lhandle    
  163. ;
  164.  
  165. : read1line { ^pfile string | pStr char -- flag }
  166.     string -> pStr
  167.     BEGIN
  168.         ^pfile @ virtual c@ -> char
  169.         1 ^pfile +!
  170.         char 0= char 13 = OR 0= WHILE
  171.         1 +> pStr 
  172.         char pStr c!
  173.     REPEAT
  174.     pStr string - string c!
  175.     char
  176. ;
  177.  
  178. : open-dates-file
  179.     " Dates" $open dup 0< 
  180.     IF drop " Dates" dup 
  181.             $create drop 
  182.             $open 
  183.     THEN
  184.     fID w!
  185. ;
  186.  
  187. : fill-list { | pfile theCell -- }
  188.     0 listRows !
  189.     open-dates-file
  190.     0 -> pfile
  191.     BEGIN
  192.         ^ pfile msgTxt read1line WHILE
  193.         1 listRows @ hupdList @ call LAddRow drop
  194.         0 -> theCell
  195.         listRows @ ^ theCell w!
  196.         1 listRows +!
  197.         msgtxt count theCell hupdList @ call LSetCell
  198.     REPEAT
  199.     fID w@ closefile
  200.     -1 hUpdList @ call LDoDraw 
  201.     hupdList @ call LAutoScroll
  202. ;
  203.  
  204. : write-list { | len theCell offset -- }
  205.     open-dates-file
  206.     0 -> offset
  207.     listRows @ 0 DO
  208.         0 -> theCell    i ^ theCell w!
  209.         0 -> len  255 ^ len w!
  210.         msgTxt ^ len theCell hUpdList @
  211.             call LGetCell
  212.         ^ len w@ -> len
  213.         13 msgTxt len + c!
  214.         1 +> len
  215.         offset len msgTxt fID w@ write
  216.         len +> offset
  217.     LOOP
  218.     0 msgtxt c!
  219.     offset 1 msgTxt fID w@ write
  220.     offset 1+ fID w@ setEOF
  221.     fID w@ closefile
  222. ;
  223.  
  224. \ UserDraw procedure
  225. \ must use (call) instead of call and use glue code
  226. \ for saving registers and setting up Forth stack
  227.  
  228. : UserDraw { theDlg theItem | iType iHdl rectbr recttl -- }
  229.     
  230.     theDlg theItem ^ iType ^ iHdl ^ recttl
  231.             (call) GetDItem
  232.     ^ recttl (call) FrameRect
  233.     theDlg 24 + @     \ visRgn of dialog window
  234.     hUpdList @        \ list handle
  235.         (call) LUpdate
  236. ;
  237.  
  238. \ UserDraw procedure glue code
  239. \ sets up local stack etc.
  240.  
  241. CODE gUser
  242.     LINK    A6,#-512             ( 512 bytes of local Forth stack )
  243.     MOVEM.L A0-A5/D0-D7,-(A7)        ( save registers )
  244.     MOVE.L A6,A3                ( setup local loop return stack )
  245.     SUBA.L #256,A3                ( in the low 256 local stack bytes )
  246.     CLR.L    D1
  247.     MOVE.W 8(A6),D1             ( theItem )
  248.     MOVE.L 10(A6),D0            ( theDialog )
  249.     MOVE.L D0,-(A6)
  250.     MOVE.L D1,-(A6)
  251.  
  252.     UserDraw
  253.  
  254.     MOVEM.L (A7)+,A0-A5/D0-D7    ( restore registers )
  255.     UNLK    A6
  256.     MOVE.L    (A7)+,A0            ( return address )
  257.     ADD.W    #6,A7                ( pop off 6 bytes of parameters )
  258.     JMP        (A0)
  259.     RTS
  260. END-CODE MACH
  261.  
  262. : update-cell { string | theCell -- }
  263.     0 -> theCell
  264.     -1 ^ theCell hupdList @ call LGetSelect
  265.         IF    
  266.             string count theCell hupdList @ 
  267.                 call LSetCell
  268.         THEN
  269. ;
  270.  
  271. : getText { dlgPtr item# string | iType iHdl iBox -- string }
  272.         dlgPtr item# ^ iType ^ iHdl ^ iBox
  273.             call GetDItem
  274.         iHdl string call GetIText
  275.         string
  276. ;
  277.         
  278. : setText { dlgPtr item# string | iType iHdl iBox -- }
  279.         dlgPtr item# ^ iType ^ iHdl ^ iBox
  280.             call GetDItem
  281.         iHdl string call SetIText
  282. ;
  283.  
  284. : setup-msg { editDlg string | -- string }
  285.             editDlg  8 string getText ( year )
  286.             editDlg  9 string 3 + getText ( month )
  287.             editDlg 10 string 6 + getText ( day )
  288.             editDlg 11 string 9 + getText ( hour )
  289.             editDlg 12 string 12 + getText ( min )
  290.             editDlg 13 string 15 + getText ( sec )
  291.  
  292.             editDlg 3 string 18 + getText ( message )
  293.                             c@ 18 + string c!
  294.  
  295.              ascii / dup string 3 + c! string 6 + c!
  296.             32 string 9 + c! 32 string 18 + c!
  297.              ascii : dup string 12 + c! string 15 + c!
  298.             string
  299. ;
  300.  
  301. : parse-msg { string | sPtr -- }
  302.     string c@ 18 - string 18 + c!
  303.     6 0 do 
  304.         string i 3 * + -> sPtr
  305.         2 sPtr c!
  306.         sPtr call stringtonum
  307.         datim i 2* + w!         
  308.     loop
  309.     datim w@ 1900 + datim w!
  310. ;
  311.  
  312. : set-dlg { editDlg string | -- }
  313.     editDlg  8 string setText ( year )
  314.     editDlg  9 string 3 + setText ( month )
  315.     editDlg 10 string 6 + setText ( day )
  316.     editDlg 11 string 9 + setText ( hour )
  317.     editDlg 12 string 12 + setText ( min )
  318.     editDlg 13 string 15 + setText ( sec )
  319.     editDlg 3 string 18 + setText ( message )    
  320. ;
  321.  
  322. : getMsg { text | editDlg itemHit iTyp iHdl iBox
  323.             -- string_or_zero }
  324.     msgID 0 -1 call GetNewDialog -> editDlg
  325.     text parse-msg
  326.     editDlg text set-dlg
  327.     0 ^ itemHit call ModalDialog
  328.     ^ itemHit w@ CASE
  329.         1 OF editDlg msgTxt setup-msg    ENDOF
  330.         2 OF ( Cancel ) 0 ENDOF
  331.     ENDCASE    
  332.     editDlg call DisposDialog
  333. ;
  334.  
  335. : userEdit { | theCell len -- }
  336.     0 -> theCell
  337.     -1 ^ theCell hupdList @ call LGetSelect
  338.     IF
  339.         255 ^ len w!
  340.         msgTxt 1+ ^ len theCell hupdList @ call LGetCell
  341.         ^ len w@ msgtxt c!
  342.         msgtxt getMsg ?dup IF
  343.             update-cell 
  344.         THEN
  345.     THEN
  346.     nmChanged on
  347. ;
  348.  
  349. : userAdd  { | theCell -- }
  350.     " yy/mm/dd hh:mm:ss Your message - " 
  351.     dup c@ 1+ msgtxt swap cmove
  352.     msgtxt getMsg IF 
  353.         0 -> theCell
  354.         -1 ^ theCell hupdList @ call LGetSelect
  355.         IF 0 theCell hUpdList @ call LSetSelect THEN        
  356.         1 listRows @ hupdList @ call LAddRow
  357.         0 -> theCell
  358.         listRows @ ^ theCell w!
  359.         1 listRows +!
  360.         msgtxt count theCell hupdList @ call LSetCell
  361.         -1 theCell hUpdList @ call LSetSelect
  362.         hupdList @ call LAutoScroll
  363.      THEN
  364.     nmChanged on
  365. ;
  366.  
  367. : userDelete { | theCell -- }
  368.     0 -> theCell
  369.     -1 ^ theCell hupdList @ call LGetSelect
  370.     IF
  371.         1 ^ theCell w@ hupdList @ call LDelRow
  372.         -1 listRows +!
  373.     THEN
  374.     nmChanged on
  375. ;
  376.  
  377. : userList-handler { | thePt thePort -- }
  378.     ^ thePort call getPort
  379.     call frontwindow call setport 
  380.     ^ thePt call getMouse            
  381.     thePt event-record modifiers + w@ 
  382.         hUpdList @
  383.         call LClick
  384.     IF ( double click ) userEdit THEN
  385.     thePort call setPort
  386. ;
  387.  
  388. : CloseMe
  389.     updPtr @ call CloseDialog
  390. ;
  391.  
  392. : QuitMe CloseMe ;
  393.  
  394. : dialog-handler 
  395.     { itemHit dlgPtr | -- }
  396.  
  397.     itemHit CASE 
  398.         1 OF CloseMe     ENDOF
  399.         2 OF userEdit     ENDOF
  400.         3 OF userAdd     ENDOF
  401.         4 OF userDelete    ENDOF
  402.  
  403.         5 OF userList-handler    ENDOF
  404.     ENDCASE
  405. ;
  406.  
  407. : installupdPtr
  408.     updPtr @ ?dup IF
  409.         nmTask @ 2+ call SetWRefCon
  410.     ELSE
  411.         cr ." Couldn't create dialog"
  412.         ABORT
  413.     THEN
  414. ;
  415.  
  416. : installuserDraw { pUser | iType iHdl rectbr recttl -- }
  417.     updPtr @ 5 ^ iType ^ iHdl ^ recttl
  418.             call GetDItem 
  419.     updPtr @ 5 ^ iType w@     pUser ^ recttl
  420.             call SetDItem 
  421.     ^ recttl 16 280 updPtr @ MakeList 
  422.                 hUpdList !
  423. ;
  424.  
  425. : UndoMe ;
  426. : CutMe ;
  427. : CopyMe ;
  428. : PasteMe ;
  429. : ClearMe ;
  430.  
  431. : do-about
  432.     128 0 CALL Alert DROP
  433. ;
  434.  
  435. : do-apple   { item# }
  436.     \ item# = 1 (About...)?
  437.     item# 1 =                     
  438.     IF    do-about
  439.     ELSE
  440.         Applemenu @ item# DAName CALL GetItem
  441.         DAName CALL OpenDeskAcc DROP
  442.     THEN ;
  443.  
  444. : DO-FILE ( item# -  )    ( handles selections from the file menu )
  445.     CASE
  446.     1 OF     CloseMe        ENDOF
  447.     2 OF    QuitMe        ENDOF
  448.     ENDCASE  
  449. ;
  450.  
  451. : DO-EDIT ( item# - )    ( handles selections from the edit menu )
  452.     dup 1- call SysEdit ( item# flag )
  453.     0= IF
  454.         CASE
  455.         1 OF    UndoMe            ENDOF
  456.         3 OF    CutMe            ENDOF
  457.         4 OF    CopyMe            ENDOF
  458.         5 OF    PasteMe            ENDOF
  459.         6 OF    ClearMe            ENDOF
  460.         ENDCASE  
  461.     THEN
  462. ;
  463.     
  464. : nmBAR-handler  ( item# menuID -  )    
  465.     CASE                    
  466.     APPLEID OF DO-APPLE      ENDOF
  467.     FILEID  OF DO-FILE      ENDOF
  468.      EDITID    OF DO-EDIT    ENDOF
  469.     ENDCASE  
  470.     0 CALL HILITEMENU  
  471. ;
  472.  
  473. : say_it 
  474.     nmPresent @ IF
  475.         1 ( mark )
  476.         0 ( no Icon )
  477.         -1 ( system beep )
  478.         msgTxt 18 + ( string to display )
  479.         -1 ( remove request )
  480.         0 ( no refCon )
  481.         notify-request
  482.         2drop
  483.     ELSE 
  484.         5 call sysbeep 
  485.     THEN
  486. ;
  487.  
  488. : get_time { | time -- secs }
  489.     ^ time call readdatetime drop @
  490. ;
  491.  
  492. : get_next_date { | len theCell secs -- }
  493.     listRows @ 0 DO
  494.         0 -> theCell i ^ theCell w!
  495.         255 ^ len w!
  496.         msgTxt 1+ ^ len theCell hupdList @ call LGetCell
  497.         ^ len w@ msgtxt c!
  498.         msgtxt parse-msg
  499.         datim call date2secs -> secs
  500.         get_time secs u< IF leave THEN
  501.         -1 -> secs \ in case no date matches
  502.     LOOP
  503.     secs nmSecs !
  504.     nmChanged off
  505. ;
  506.  
  507. : wait { ticks | time -- }
  508.     call tickcount ticks + -> time
  509.     begin
  510.         pause
  511.         call tickcount time > 
  512.     until
  513. ;
  514.  
  515. : check_next_date 
  516.     nmChanged @ IF get_next_date THEN
  517.     nmSecs @ get_time
  518.     u< IF 
  519.         say_it
  520.         60 wait 
  521.         nmChanged on 
  522.     THEN    
  523. ;
  524.  
  525. : check_dialog_up
  526.     updPtr @ wVisible + c@
  527.     0= IF write-list bye
  528.      THEN
  529. ;
  530.  
  531. : go.nm 
  532.     ACTIVATE
  533.     fill-list
  534.     ['] dialog-handler modelessVector !
  535.     ['] nmBar-handler menu-vector !
  536.     nmWindow dup call showWindow
  537.         call selectWindow
  538.     updPtr @ dup call showWindow
  539.         call selectWindow
  540.         call DrawMenuBar
  541.     begin    
  542.         PAUSE 
  543.         check_next_date
  544.         check_dialog_up
  545.     again
  546. ;
  547.  
  548. : nmPresent?
  549.         NMTrap# CALL GetTrapAddress
  550.         UnkTrap# CALL GetTrapAddress
  551.         = IF 0 ELSE 1 THEN
  552.         nmPresent !
  553. ;
  554.  
  555. : start 
  556.     nmPresent?
  557.     nmWindow ADD
  558.     nmWindow nmTask BUILD
  559.  
  560.     nmBar ADD
  561.     nmBar AppleMenu ADD
  562.     AppleMenu @ ascii DRVR CALL AddResMenu
  563.     nmBar FileMenu ADD
  564.     nmBar EditMenu ADD
  565.     nmBar nmTask mbar>task
  566.  
  567.     updID updStore -1 call GetNewDialog
  568.     updPtr !
  569.  
  570.     installupdPtr
  571.     ['] gUser installUserDraw
  572.  
  573.     nmChanged on
  574.     nmTask go.nm 
  575. ;
  576.